home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 November / Chip Kasım 2000.iso / prog / share / 11 / setup.exe / %MAINDIR% / DEMOS / CIMAIL / INTMAIL / mailsppt.bas < prev    next >
Encoding:
BASIC Source File  |  2000-09-07  |  6.4 KB  |  214 lines
  1. Attribute VB_Name = "MailSupport"
  2. Option Explicit
  3.  
  4. '<Constant>--------------------------------------------
  5. Public Const ciAddAddress           As Integer = 0
  6. Public Const ciAddressProperties    As Integer = 1
  7.  
  8. Public AttachmentStream             As String
  9. '</Constant>-------------------------------------------
  10.  
  11. '------------------------------------------------------
  12. '<Purpose> reads an encoded file into a data stream
  13. ' in preparation to send it
  14. '------------------------------------------------------
  15. Public Function ReadTempFile(DestinationFileName As String) As Boolean
  16.     Dim hFile           As Integer
  17.     Dim Remainder       As Integer
  18.     Dim BlockCount      As Long
  19.     Dim FileSize        As Long
  20.     Dim NumberBlocks    As Long
  21.     Dim Buffer          As String
  22.     
  23.     Const MaxBlockSize  As Integer = 32767
  24.  
  25.     '---- Obtain a free file number
  26.     hFile = FreeFile
  27.     
  28.     '---- clear the attachment data stream
  29.     AttachmentStream = ""
  30.     
  31.     On Error GoTo BadRead
  32.     '---- Who cares which control you passed, then both have the same property names
  33.     Open DestinationFileName For Binary Access Read As #hFile
  34.       
  35.     '---- read in blocks of data from the file
  36.     NumberBlocks = LOF(hFile) \ MaxBlockSize
  37.     Remainder = LOF(hFile) Mod MaxBlockSize
  38.     For BlockCount = 1 To NumberBlocks
  39.         Buffer = Space(MaxBlockSize)
  40.         Get #hFile, , Buffer
  41.         AttachmentStream = AttachmentStream & Buffer
  42.     Next
  43.   
  44.     '---- read in any remainder from the file
  45.     If Remainder Then
  46.         Buffer = Space(Remainder)
  47.         Get #hFile, , Buffer
  48.         AttachmentStream = AttachmentStream & Buffer
  49.     End If
  50.   
  51.     Close #hFile
  52.     
  53.     '---- processed ok
  54.     ReadTempFile = True
  55.     On Error GoTo 0
  56.     Exit Function
  57.     
  58. '---- Add specific error handling here
  59. BadRead:
  60.     ReadTempFile = False
  61.     On Error GoTo 0
  62.  
  63. End Function
  64. Public Function ExtractMessageBody(FileName As String) As String
  65.     Dim CharPos         As Integer
  66.     Dim hFile           As Integer
  67.     Dim Remainder       As Integer
  68.     Dim BlockCount      As Long
  69.     Dim FileSize        As Long
  70.     Dim NumberBlocks    As Long
  71.     Dim Buffer          As String
  72.     Dim Temp            As String
  73.     Dim MimeInfo        As String
  74.     Dim Boundary        As String
  75.     
  76.     Const MaxBlockSize  As Integer = 32767
  77.  
  78.     '---- Obtain a free file number
  79.     hFile = FreeFile
  80.     
  81.     On Error GoTo BadRead
  82.     '---- Who cares which control you passed, then both have the same property names
  83.     Open FileName For Binary Access Read As #hFile
  84.       
  85.     '---- read in blocks of data from the file
  86.     NumberBlocks = LOF(hFile) \ MaxBlockSize
  87.     Remainder = LOF(hFile) Mod MaxBlockSize
  88.     For BlockCount = 1 To NumberBlocks
  89.         Buffer = Space(MaxBlockSize)
  90.         Get #hFile, , Buffer
  91.         Temp = Temp & Buffer
  92.     Next
  93.   
  94.     '---- read in any remainder from the file
  95.     If Remainder Then
  96.         Buffer = Space(Remainder)
  97.         Get #hFile, , Buffer
  98.         Temp = Temp & Buffer
  99.     End If
  100.   
  101.     Close #hFile
  102.     
  103.     ExtractMessageBody = Temp
  104.     On Error GoTo 0
  105.     Exit Function
  106.     
  107.     '---- now check the temp string for an encoded attachment
  108.     CharPos = InStr(Temp, "Content-Type:")
  109.     If (CharPos = 0) Then
  110.         ExtractMessageBody = ""
  111.         Exit Function
  112.     End If
  113.         
  114.     '---- try to determine destination file name
  115.     MimeInfo = Mid$(Temp, CharPos)
  116.     CharPos = InStr(MimeInfo, "; boundary=")
  117.     If (CharPos > 0) Then
  118.         Boundary = Mid(MimeInfo, CharPos + Len("; boundary=") + 1, CharPos + 100)
  119.         CharPos = InStr(Boundary, Chr$(34))
  120.         Boundary = left(Boundary, CharPos - 1)
  121.     Else
  122.         ExtractMessageBody = ""
  123.         Exit Function
  124.     End If
  125.     CharPos = InStr(MimeInfo, "Content-Type: text/plain;")
  126.     If CharPos Then
  127.         MimeInfo = Mid(MimeInfo, CharPos)
  128.         CharPos = InStr(MimeInfo, vbCrLf & vbCrLf)
  129.         MimeInfo = Mid(MimeInfo, CharPos + 4)
  130.         CharPos = InStr(MimeInfo, Boundary)
  131.         ExtractMessageBody = left(MimeInfo, CharPos - 1)
  132.     End If
  133.         
  134.     '---- checked ok
  135.     On Error GoTo 0
  136.     Exit Function
  137.     
  138. '---- Add specific error handling here
  139. BadRead:
  140.     ExtractMessageBody = ""
  141.     On Error GoTo 0
  142.  
  143. End Function
  144. '---------------------------------------------------------
  145. '<Purpose> checks a message to see if it is an attachment
  146. '---------------------------------------------------------
  147. Public Function CheckForAttachment(FileName As String, SentFile As String, MessageNumber As Integer) As Boolean
  148.     Dim CharPos         As Integer
  149.     Dim hFile           As Integer
  150.     Dim Remainder       As Integer
  151.     Dim BlockCount      As Long
  152.     Dim FileSize        As Long
  153.     Dim NumberBlocks    As Long
  154.     Dim Buffer          As String
  155.     Dim Temp            As String
  156.     Dim MimeInfo        As String
  157.     
  158.     Const MaxBlockSize  As Integer = 32767
  159.  
  160.     '---- Obtain a free file number
  161.     hFile = FreeFile
  162.     
  163.     On Error GoTo BadRead
  164.     '---- Who cares which control you passed, then both have the same property names
  165.     Open FileName For Binary Access Read As #hFile
  166.       
  167.     '---- read in blocks of data from the file
  168.     NumberBlocks = LOF(hFile) \ MaxBlockSize
  169.     Remainder = LOF(hFile) Mod MaxBlockSize
  170.     For BlockCount = 1 To NumberBlocks
  171.         Buffer = Space(MaxBlockSize)
  172.         Get #hFile, , Buffer
  173.         Temp = Temp & Buffer
  174.     Next
  175.   
  176.     '---- read in any remainder from the file
  177.     If Remainder Then
  178.         Buffer = Space(Remainder)
  179.         Get #hFile, , Buffer
  180.         Temp = Temp & Buffer
  181.     End If
  182.   
  183.     Close #hFile
  184.     
  185.     '---- now check the temp string for an encoded attachment
  186.     CharPos = InStr(Temp, "Content-Type:")
  187.     If (CharPos = 0) Then
  188.         CheckForAttachment = False
  189.         Exit Function
  190.     End If
  191.         
  192.     '---- try to determine destination file name
  193.     MimeInfo = Mid$(Temp, CharPos)
  194.     CharPos = InStr(MimeInfo, "; name=")
  195.     If (CharPos > 0) Then
  196.         SentFile = Mid(MimeInfo, CharPos + Len("; name=") + 1, CharPos + 100)
  197.         CharPos = InStr(SentFile, """")
  198.         SentFile = "c:\" & left(SentFile, CharPos - 1)
  199.     Else
  200.         CheckForAttachment = False
  201.         Exit Function
  202.     End If
  203.     
  204.     '---- checked ok
  205.     CheckForAttachment = True
  206.     On Error GoTo 0
  207.     Exit Function
  208.     
  209. '---- Add specific error handling here
  210. BadRead:
  211.     CheckForAttachment = False
  212.     On Error GoTo 0
  213. End Function
  214.